home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / ansi.swg / 0001_ANSI Character Driver.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  8.4 KB  |  333 lines
  1. Unit Ansi; (* Ho ho ho -Santa Clause) *)
  2.  
  3. Interface
  4.  
  5. Uses Crt;
  6.  
  7. Procedure Display_ANSI(ch:Char);
  8. { Displays ch following ANSI Graphics protocol }
  9.  
  10. {---------------------------------------------------------------------- -----}
  11. { Useful information For porting this thing over to other computers:
  12.  
  13.   Change background Text color        Change foreground Text color
  14.   TextBackground(0) = black           TextColor(0) = black
  15.   TextBackground(1) = blue            TextColor(1) = blue
  16.   TextBackground(2) = green           TextColor(2) = green
  17.   TextBackground(3) = cyan            TextColor(3) = cyan
  18.   TextBackground(4) = red             TextColor(4) = red
  19.   TextBackground(5) = Magenta         TextColor(5) = magenta
  20.   TextBackground(6) = brown           TextColor(6) = brown
  21.   TextBackground(7) = light grey      TextColor(7) = white
  22.                                       TextColor(8) = grey
  23.   Delete(s,i,c);                      TextColor(9) = bright blue
  24.     Delete c Characters from          TextColor(10)= bright green
  25.     String s starting at i            TextColor(11)= bright cyan
  26.   Val(s,v,c);                         TextColor(12)= bright red
  27.     convert String s to numeric       TextColor(13)= bright magenta
  28.     value v. code=0 if ok.            TextColor(14)= bright yellow
  29.   Length(s)                           TextColor(15)= bright white
  30.     length of String s
  31. }
  32.  
  33. Implementation
  34.  
  35. Var
  36.   ANSI_St   :String ;  {stores ANSI escape sequence if receiving ANSI}
  37.   ANSI_SCPL :Integer;  {stores the saved cursor position line}
  38.   ANSI_SCPC :Integer;  {   "    "    "      "       "    column}
  39.   ANSI_FG   :Integer;  {stores current foreground}
  40.   ANSI_BG   :Integer;  {stores current background}
  41.   ANSI_C,ANSI_I,ANSI_B,ANSI_R:Boolean ;  {stores current attribute options}
  42.  
  43. p,x,y : Integer;
  44.  
  45. Procedure Display_ANSI(ch:Char);
  46. { Displays ch following ANSI Graphics protocal }
  47.  
  48.   Procedure TABULATE;
  49.   Var x:Integer;
  50.   begin
  51.     x:=WhereX;
  52.     if x<80 then
  53.       Repeat
  54.         Inc(x);
  55.       Until (x MOD 8)=0;
  56.     if x=80 then x:=1;
  57.     GotoXY(x,WhereY);
  58.     if x=1 then WriteLN;
  59.   end;
  60.  
  61.   Procedure BACKSPACE;
  62.   Var x:Integer;
  63.   begin
  64.     if WhereX>1 then
  65.       Write(^H,' ',^H)
  66.     else
  67.       if WhereY>1 then begin
  68.         GotoXY(80,WhereY-1);
  69.         Write(' ');
  70.         GotoXY(80,WhereY-1);
  71.       end;
  72.   end;
  73.  
  74.   Procedure TTY(ch:Char);
  75.   Var x:Integer;
  76.   begin
  77.     if ANSI_C then begin
  78.       if ANSI_I then ANSI_FG:=ANSI_FG or 8;
  79.       if ANSI_B then ANSI_FG:=ANSI_FG or 16;
  80.       if ANSI_R then begin
  81.         x:=ANSI_FG;
  82.         ANSI_FG:=ANSI_BG;
  83.         ANSI_BG:=x;
  84.       end;
  85.       ANSI_C:=False;
  86.     end;
  87.     TextColor(ANSI_FG);
  88.     TextBackground(ANSI_BG);
  89.     Case Ch of
  90.       ^G: begin
  91.             Sound(2000);
  92.             Delay(75);
  93.             NoSound;
  94.           end;
  95.       ^H: Backspace;
  96.       ^I: Tabulate;
  97.       ^J: begin
  98.             TextBackground(0);
  99.             Write(^J);
  100.           end;
  101.       ^K: GotoXY(1,1);
  102.       ^L: begin
  103.             TextBackground(0);
  104.             ClrScr;
  105.           end;
  106.       ^M: begin
  107.             TextBackground(0);
  108.             Write(^M);
  109.           end;
  110.       else Write(Ch);
  111.     end;
  112.   end;
  113.  
  114.   Procedure ANSIWrite(S:String);
  115.   Var x:Integer;
  116.   begin
  117.     For x:=1 to Length(S) do
  118.       TTY(S[x]);
  119.   end;
  120.  
  121.   Function Param:Integer;   {returns -1 if no more parameters}
  122.   Var S:String;
  123.       x,XX:Integer;
  124.       B:Boolean;
  125.   begin
  126.     B:=False;
  127.     For x:=3 to Length(ANSI_St) DO
  128.       if ANSI_St[x] in ['0'..'9'] then B:=True;
  129.     if not B then
  130.       Param:=-1
  131.     else begin
  132.       S:='';
  133.       x:=3;
  134.       if ANSI_St[3]=';' then begin
  135.         Param:=0;
  136.         Delete(ANSI_St,3,1);
  137.         Exit;
  138.       end;
  139.       Repeat
  140.         S:=S+ANSI_St[x];
  141.         x:=x+1;
  142.       Until (NOT (ANSI_St[x] in ['0'..'9'])) or (Length(S)>2) or (x>Length(ANSI_St));
  143.       if Length(S)>2 then begin
  144.         ANSIWrite(ANSI_St+Ch);
  145.         ANSI_St:='';
  146.         Param:=-1;
  147.         Exit;
  148.       end;
  149.       Delete(ANSI_St,3,Length(S));
  150.       if ANSI_St[3]=';' then Delete(ANSI_St,3,1);
  151.       Val(S,x,XX);
  152.       Param:=x;
  153.     end;
  154.   end;
  155.  
  156. begin
  157.   if (Ch<>#27) and (ANSI_St='') then begin
  158.     TTY(Ch);
  159.     Exit;
  160.   end;
  161.   if Ch=#27 then begin
  162.     if ANSI_St<>'' then begin
  163.       ANSIWrite(ANSI_St+#27);
  164.       ANSI_St:='';
  165.     end else ANSI_St:=#27;
  166.     Exit;
  167.   end;
  168.   if ANSI_St=#27 then begin
  169.     if Ch='[' then
  170.       ANSI_St:=#27+'['
  171.     else begin
  172.       ANSIWrite(ANSI_St+Ch);
  173.       ANSI_St:='';
  174.     end;
  175.     Exit;
  176.   end;
  177.   if (Ch='[') and (ANSI_St<>'') then begin
  178.     ANSIWrite(ANSI_St+'[');
  179.     ANSI_St:='';
  180.     Exit;
  181.   end;
  182.   if not (Ch in ['0'..'9',';','A'..'D','f','H','J','K','m','s','u']) then begin
  183.     ANSIWrite(ANSI_St+Ch);
  184.     ANSI_St:='';
  185.     Exit;
  186.   end;
  187.   if Ch in ['A'..'D','f','H','J','K','m','s','u'] then begin
  188.     Case Ch of
  189.     'A': begin
  190.            p:=Param;
  191.            if p=-1 then p:=1;
  192.            if WhereY-p<1 then
  193.              GotoXY(WhereX,1)
  194.            else GotoXY(WhereX,WhereY-p);
  195.          end;
  196.     'B': begin
  197.            p:=Param;
  198.            if p=-1 then p:=1;
  199.            if WhereY+p>25 then
  200.              GotoXY(WhereX,25)
  201.            else GotoXY(WhereX,WhereY+p);
  202.          end;
  203.     'C': begin
  204.            p:=Param;
  205.            if p=-1 then p:=1;
  206.            if WhereX+p>80 then
  207.              GotoXY(80,WhereY)
  208.            else GotoXY(WhereX+p,WhereY);
  209.          end;
  210.     'D': begin
  211.            p:=Param;
  212.            if p=-1 then p:=1;
  213.            if WhereX-p<1 then
  214.              GotoXY(1,WhereY)
  215.            else GotoXY(WhereX-p,WhereY);
  216.          end;
  217. 'H','f': begin
  218.            Y:=Param;
  219.            x:=Param;
  220.            if Y<1 then Y:=1;
  221.            if x<1 then x:=1;
  222.            if (x>80) or (x<1) or (Y>25) or (Y<1) then begin
  223.              ANSI_St:='';
  224.              Exit;
  225.            end;
  226.            GotoXY(x,Y);
  227.          end;
  228.     'J': begin
  229.            p:=Param;
  230.            if p=2 then begin
  231.              TextBackground(0);
  232.              ClrScr;
  233.            end;
  234.            if p=0 then begin
  235.              x:=WhereX;
  236.              Y:=WhereY;
  237.              Window(1,y,80,25);
  238.              TextBackground(0);
  239.              ClrScr;
  240.              Window(1,1,80,25);
  241.              GotoXY(x,Y);
  242.            end;
  243.            if p=1 then begin
  244.              x:=WhereX;
  245.              Y:=WhereY;
  246.              Window(1,1,80,WhereY);
  247.              TextBackground(0);
  248.              ClrScr;
  249.              Window(1,1,80,25);
  250.              GotoXY(x,Y);
  251.            end;
  252.          end;
  253.     'K': begin
  254.            TextBackground(0);
  255.            ClrEol;
  256.          end;
  257.     'm': begin
  258.            if ANSI_St=#27+'[' then begin
  259.              ANSI_FG:=7;
  260.              ANSI_BG:=0;
  261.              ANSI_I:=False;
  262.              ANSI_B:=False;
  263.              ANSI_R:=False;
  264.            end;
  265.            Repeat
  266.              p:=Param;
  267.              Case p of
  268.                -1:;
  269.                 0:begin
  270.                     ANSI_FG:=7;
  271.                     ANSI_BG:=0;
  272.                     ANSI_I:=False;
  273.                     ANSI_R:=False;
  274.                     ANSI_B:=False;
  275.                   end;
  276.                 1:ANSI_I:=True;
  277.                 5:ANSI_B:=True;
  278.                 7:ANSI_R:=True;
  279.                30:ANSI_FG:=0;
  280.                31:ANSI_FG:=4;
  281.                32:ANSI_FG:=2;
  282.                33:ANSI_FG:=6;
  283.                34:ANSI_FG:=1;
  284.                35:ANSI_FG:=5;
  285.                36:ANSI_FG:=3;
  286.                37:ANSI_FG:=7;
  287.                40:ANSI_BG:=0;
  288.                41:ANSI_BG:=4;
  289.                42:ANSI_BG:=2;
  290.                43:ANSI_BG:=6;
  291.                44:ANSI_BG:=1;
  292.                45:ANSI_BG:=5;
  293.                46:ANSI_BG:=3;
  294.                47:ANSI_BG:=7;
  295.              end;
  296.              if ((p>=30) and (p<=47)) or (p=1) or (p=5) or (p=7) then
  297. ANSI_C:=True;
  298.            Until p=-1;
  299.          end;
  300.     's': begin
  301.            ANSI_SCPL:=WhereY;
  302.            ANSI_SCPC:=WhereX;
  303.          end;
  304.     'u': begin
  305.            if ANSI_SCPL>-1 then GotoXY(ANSI_SCPC,ANSI_SCPL);
  306.            ANSI_SCPL:=-1;
  307.            ANSI_SCPC:=-1;
  308.          end;
  309.     end;
  310.     ANSI_St:='';
  311.     Exit;
  312.   end;
  313.   if Ch in ['0'..'9',';'] then
  314.     ANSI_St:=ANSI_St+Ch;
  315.   if Length(ANSI_St)>50 then begin
  316.     ANSIWrite(ANSI_St);
  317.     ANSI_St:='';
  318.     Exit;
  319.   end;
  320. end;
  321.  
  322.  
  323. begin
  324.   ANSI_St:='';
  325.   ANSI_SCPL:=-1;
  326.   ANSI_SCPC:=-1;
  327.   ANSI_FG:=7;
  328.   ANSI_BG:=0;
  329.   ANSI_C:=False;
  330.   ANSI_I:=False;
  331.   ANSI_B:=False;
  332.   ANSI_R:=False;
  333. END.